perm filename RAND[226,DBL]2 blob
sn#029782 filedate 1973-03-09 generic text, type T, neo UTF8
00100 (DE RANDOM () (QUOTIENT
00200 (BOOLE 1 (LSH (RANDM) -3) 7777777777) _RD))
00300
00400 (LAP RANDM SUBR)
00500 (MOVE 1 (SPECIAL _RX))
00600 (220000 1 (SPECIAL _RA))
00700 (ADD 1 (C 15460 0 616031))
00800 (404000 1 (C 377777 0 777777))
00900 (MOVEM 1 (SPECIAL _RX))
01000 (MOVEI 2 (QUOTE FIXNUM))
01100 (CALL 2 (E MAKNUM))
01200 (POPJ P)
01300 NIL
01400
01500 (DE INITRAND () (PROG (N)
01600 (SETQ _RD (PLUS 10000000000 0.0))
01700 (INITRAND1)
01800 (SETQ N (ADD1 (REMAINDER (TIME) 100)))
01900 LOOP (COND ((GREATERP (SETQ N (SUB1 N)) 0)
02000 (RANDOM) (GO LOOP)))
02100 (RETURN NIL) ]
02200
02300 (LAP INITRAND1 SUBR)
02400 (MOVE 1 (C 0 0 61356))
02500 (MOVEM 1 (SPECIAL _RX))
02600 (MOVE 1 (C 37556 0 736271))
02700 (MOVEM 1 (SPECIAL _RA))
02800 (POPJ P)
02900 NIL
03000
03100 (DE SHUFFLE (DECK) (SHUF2 (LENGTH DECK) (LENGTH DECK) DECK))
03200
03300 (DE SHUF2 (N TOT DECK) (COND
03400 ((ZEROP N) DECK)
03500 (T (SHUF2 (SUB1 N) TOT (EXCHANGE DECK N
03600 (ADD1 (FIX (TIMES TOT (RANDOM]
03700
03800 (DE EXCHANGE (L N M) (COND
03900 ((*LESS M N) (EX2 L M N))
04000 (T (EX2 L N M]
04100
04200 (DE EX2 (L N M) (COND
04300 ((EQUAL N 1) (SETQ TEMP (CAR L)) (CONS (NTH M L)
04400 (EX2 (CDR L) (SUB1 N) (SUB1 M))))
04500 ((EQUAL M 1) (CONS TEMP (CDR L)))
04600 (T (CONS (CAR L) (EX2 (CDR L) (SUB1 N) (SUB1 M]
04700
04800 (DE NTH (N L) (COND
04900 ((EQUAL N 1) (CAR L))
05000 (T (NTH (SUB1 N) (CDR L]
05100